Podsumowanie

Wykorzystane biblioteki

W raporcie wykorzystano następujące biblioteki:

library(knitr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(plotly)
library(ggcorrplot)
library(caret)
library(tibble)

Wczytanie danych

Materials Project to inicjatywa naukowa Departamentu Energii USA, której celem jest dostarczanie otwartych danych i narzędzi do analizy materiałów. Jednym z kluczowych zbiorów danych dostępnych w ramach Materials Project jest baza danych dotycząca materiałów używanych w bateriach, która zawiera informacje o ich składzie chemicznym i parametrach wydajnościowych.

df <- read.csv("./data/mp_batteries.csv", na.strings="?")
df <- tbl_df(df)

Opis atrybutów

Nazwa atrybutu Opis
Battery ID Identyfikator baterii.
Battery Formula Wzór chemiczny materiału baterii.
Working Ion Główny jon, który odpowiada za transport ładunku w baterii.
Formula Charge Wzór chemiczny materiału baterii w stanie naładowanym.
Formula Discharge Wzór chemiczny materiału baterii w stanie rozładowanym.
Max Delta Volume Zmiana objętości w % dla danego kroku napięcia za pomocą wzoru : max(charge, discharge)/min(charge, discharge) -1.
Average Voltage Średnie napięcie dla poszczególnego kroku napięcia.
Gravimetric Capacity Pojemność grawimetryczna, czyli ilość energii na jednostkę masy (mAh/g).
Volumetric Capacity Pojemność wolumetryczna, czyli ilość energii na jednostkę objętości (mAh/cm³).
Gravimetric Energy Gęstość energii w odniesieniu do masy baterii (Wh/kg).
Volumetric Energy Gęstość energii w odniesieniu do objętości baterii (Wh/L).
Atomic Fraction Charge Udział atomowy składników w stanie naładowanym.
Atomic Fraction Discharge Udział atomowy składników w stanie rozładowanym.
Stability Charge Wskaźnik stabilności materiału w stanie naładowanym.
Stability Discharge Wskaźnik stabilności materiału w stanie rozładowanym.
Steps Liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana, oparta na stabilnych stanach pośrednich.
Max Voltage Step Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia.

Czyszczenie zbioru danych

Poniżej znajduje się lista kroków wykonanych na zbiorze danych w celu przygotowania go do anaizy.

Struktura danych

## tibble [4,351 × 17] (S3: tbl_df/tbl/data.frame)
##  $ Battery.ID               : chr [1:4351] "mp-30_Al" "mp-1022721_Al" "mp-8637_Al" "mp-129_Al" ...
##  $ Battery.Formula          : chr [1:4351] "Al0-2Cu" "Al1-3Cu" "Al0-5Mo" "Al0-12Mo" ...
##  $ Working.Ion              : chr [1:4351] "Al" "Al" "Al" "Al" ...
##  $ Formula.Charge           : chr [1:4351] "Cu" "AlCu" "Mo" "Mo" ...
##  $ Formula.Discharge        : chr [1:4351] "Al2Cu" "Al3Cu" "Al5Mo" "Al12Mo" ...
##  $ Max.Delta.Volume         : num [1:4351] 3.04 1.24 4.76 12.72 12.49 ...
##  $ Average.Voltage          : num [1:4351] 0.089 -0.0216 0.1228 0.0431 0.0292 ...
##  $ Gravimetric.Capacity     : num [1:4351] 1368 1113 1742 2299 1901 ...
##  $ Volumetric.Capacity      : num [1:4351] 5563 4419 7176 7346 7333 ...
##  $ Gravimetric.Energy       : num [1:4351] 121.8 -24 213.8 99.1 55.6 ...
##  $ Volumetric.Energy        : num [1:4351] 495.3 -95.4 880.9 316.8 214.4 ...
##  $ Atomic.Fraction.Charge   : num [1:4351] 0 0.5 0 0 0 ...
##  $ Atomic.Fraction.Discharge: num [1:4351] 0.667 0.75 0.833 0.923 0.923 ...
##  $ Stability.Charge         : num [1:4351] 0 0.0741 0.4115 0 0 ...
##  $ Stability.Discharge      : num [1:4351] 0 0.0962 0.0452 0.0114 0 ...
##  $ Steps                    : int [1:4351] 1 1 1 1 1 1 1 1 1 1 ...
##  $ Max.Voltage.Step         : num [1:4351] 0 0 0 0 0 0 0 0 0 0 ...

Kilka pierwszych wierszy ze zbioru danych

## # A tibble: 6 × 17
##   Battery.ID    Battery.Formula Working.Ion Formula.Charge Formula.Discharge
##   <chr>         <chr>           <chr>       <chr>          <chr>            
## 1 mp-30_Al      Al0-2Cu         Al          Cu             Al2Cu            
## 2 mp-1022721_Al Al1-3Cu         Al          AlCu           Al3Cu            
## 3 mp-8637_Al    Al0-5Mo         Al          Mo             Al5Mo            
## 4 mp-129_Al     Al0-12Mo        Al          Mo             Al12Mo           
## 5 mp-91_Al      Al0-12W         Al          W              Al12W            
## 6 mp-1055908_Al Al0-12Mn        Al          Mn             MnAl12           
## # ℹ 12 more variables: Max.Delta.Volume <dbl>, Average.Voltage <dbl>,
## #   Gravimetric.Capacity <dbl>, Volumetric.Capacity <dbl>,
## #   Gravimetric.Energy <dbl>, Volumetric.Energy <dbl>,
## #   Atomic.Fraction.Charge <dbl>, Atomic.Fraction.Discharge <dbl>,
## #   Stability.Charge <dbl>, Stability.Discharge <dbl>, Steps <int>,
## #   Max.Voltage.Step <dbl>

Analiza jakości danych

Sprawdzenie ile jest pustych wartościami w poszczególnych kolumnach oraz ile w zbiorze jest zduplikowanych wierszy.

colSums(is.na(df))
##                Battery.ID           Battery.Formula               Working.Ion 
##                         0                         0                         0 
##            Formula.Charge         Formula.Discharge          Max.Delta.Volume 
##                         0                         0                         0 
##           Average.Voltage      Gravimetric.Capacity       Volumetric.Capacity 
##                         0                         0                         0 
##        Gravimetric.Energy         Volumetric.Energy    Atomic.Fraction.Charge 
##                         0                         0                         0 
## Atomic.Fraction.Discharge          Stability.Charge       Stability.Discharge 
##                         0                         0                         0 
##                     Steps          Max.Voltage.Step 
##                         0                         0
duplicates_count <- sum(duplicated(df))
print(paste("Liczba zduplikowanych wierszy:", duplicates_count))
## [1] "Liczba zduplikowanych wierszy: 0"

Z powodu braku zduplikowanych danych oraz braku wartości pustych w zbiorze - dane nie wymagają czyszczenia.

Podstawowe statystyki

Zbiór danych składa się z 4351 wierszy (obserwacji) i 17 kolumn (atrybutów).

kable(summary(df %>% select(Max.Delta.Volume:Volumetric.Energy)))
Max.Delta.Volume Average.Voltage Gravimetric.Capacity Volumetric.Capacity Gravimetric.Energy Volumetric.Energy
Min. : 0.00002 Min. :-7.755 Min. : 5.176 Min. : 24.08 Min. :-583.5 Min. :-2208.1
1st Qu.: 0.01747 1st Qu.: 2.226 1st Qu.: 88.108 1st Qu.: 311.62 1st Qu.: 211.7 1st Qu.: 821.6
Median : 0.04203 Median : 3.301 Median : 130.691 Median : 507.03 Median : 401.8 Median : 1463.8
Mean : 0.37531 Mean : 3.083 Mean : 158.291 Mean : 610.62 Mean : 444.1 Mean : 1664.0
3rd Qu.: 0.08595 3rd Qu.: 4.019 3rd Qu.: 187.600 3rd Qu.: 722.75 3rd Qu.: 614.4 3rd Qu.: 2252.3
Max. :293.19322 Max. :54.569 Max. :2557.627 Max. :7619.19 Max. :5926.9 Max. :18305.9 
kable(summary(df %>% select(Atomic.Fraction.Charge:Max.Voltage.Step)))
Atomic.Fraction.Charge Atomic.Fraction.Discharge Stability.Charge Stability.Discharge Steps Max.Voltage.Step
Min. :0.00000 Min. :0.007407 Min. :0.00000 Min. :0.00000 Min. :1.000 Min. : 0.0000
1st Qu.:0.00000 1st Qu.:0.086957 1st Qu.:0.03301 1st Qu.:0.01952 1st Qu.:1.000 1st Qu.: 0.0000
Median :0.00000 Median :0.142857 Median :0.07319 Median :0.04878 Median :1.000 Median : 0.0000
Mean :0.03986 Mean :0.159077 Mean :0.14257 Mean :0.12207 Mean :1.167 Mean : 0.1503
3rd Qu.:0.04762 3rd Qu.:0.200000 3rd Qu.:0.13160 3rd Qu.:0.09299 3rd Qu.:1.000 3rd Qu.: 0.0000
Max. :0.90909 Max. :0.993333 Max. :6.48710 Max. :6.27781 Max. :6.000 Max. :26.9607

Cechy statystyczne zbioru danych

W tym zbiorze można odczytać następujące cechy statystyczne:

  • Wartości skrajne: Zauważalna jest duża zmienność i obecność skrajnych wartości (np. Max.Delta.Volume, Volumetric.Capacity, Gravimetric.Energy), które mogą wymagać dalszej analizy pod kątem anomalii.
  • Wartości ujemne: Atrybuty takie jak Average.Voltage, Gravimetric.Energy, Volumetric.Energy zawierają ujemne wartości, co sugeruje możliwość błędów w danych lub specyficzną charakterystykę badanych baterii.
  • Skumulowane dane: Większość danych ma bardzo małą zmienność w niektórych atrybutach (np. Steps, Max.Voltage.Step), co może sugerować, że niektóre zmienne są stałe w większości przypadków.

Analiza danych

Poniżej znajduje się analiza zbioru danych w celu zbadania rozkładów wartości poszczególnych atrybutów oraz sprawdzenia występujących między nimi korelacji.

Rozkład wartości atrybutów

p <- ggplot(df, aes(x = `Working.Ion`)) +
  geom_bar(fill = "blue", color = "black") +
  labs(
    title = "Histogram głównego jonu baterii",
    x = "Główny Jon",
    y = "Liczba"
  ) +
  theme_light()

ggplotly(p)
p1 <- ggplot(df, aes(x = `Max.Delta.Volume`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład maksymalnej zmiany objętości dla danego kroku",
    x = "Maksymalna zmiana objętości",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Average.Voltage`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład średniego napięcia",
    x = "Średnie napięcie",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Gravimetric.Capacity`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład pojemności grawimetrycznej",
    x = "Pojemność grawimetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Volumetric.Capacity`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład pojemności wolumetrycznej",
    x = "Pojemność wolumetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Gravimetric.Energy`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład energii grawimetrycznej",
    x = "Energia grawimetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Volumetric.Energy`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład energii wolumetrycznej",
    x = "Energia wolumetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Charge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład udziału atomowego składników w stanie naładowanym",
    x = "Udział atomowy składników",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Discharge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład udziału atomowego składników w stanie rozładowanym",
    x = "Udział atomowy składników",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Stability.Charge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład wskaźnika stabilności materiału w stanie naładowanym",
    x = "Wskaźnik stabilności materiału",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Stability.Discharge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład wskaźnika stabilności materiału w stanie rozładowanym",
    x = "Wskaźnik stabilności materiału",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Steps`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana",
    x = "Liczba kroków",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
p1 <- ggplot(df, aes(x = `Max.Voltage.Step`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  labs(
    title = "Rozkład maksymalnej bezwzględnej różnica między sąsiednimi krokami napięcia",
    x = "Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

Korelacja pomiędzy atrybutami

cor_matrix <- df %>%
  select(`Max.Delta.Volume`:last_col()) %>%
  cor(method="pearson")

correlation_long <- cor_matrix %>%
  as.data.frame() %>%
  mutate(variable1 = colnames(cor_matrix)) %>%
  pivot_longer(-variable1,
    names_to = "variable2",
    values_to = "correlation"
  ) %>%
  filter(variable1 > variable2)

correlation_plot <- ggplot(
  correlation_long,
  aes(x = variable1, y = variable2, fill = correlation)
) +
  geom_tile() +
  scale_fill_gradient2(
    low = "blue", mid = "white", high = "red",
    midpoint = 0, limits = c(-1, 1)
  ) +
  geom_text(aes(label = sprintf("%.2f", correlation)), size = 3) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    axis.title = element_blank()
  ) +
  labs(fill = "Korelacja")

ggplotly(correlation_plot)
plot_correlation <- function(df, var1, var2) {
  ggplot(df, aes_string(x = var1, y = var2)) +
    geom_point(alpha = 0.5, color = "blue") +
    geom_smooth(method = "lm", se = TRUE, color = "red", fill = "pink") +
    theme_minimal() +
    labs(
      title = paste("Korelacja między", var1, "a", var2),
      x = var1,
      y = var2
    ) +
    theme(
      plot.title = element_text(hjust = 0.5, size = 14),
      axis.text = element_text(size = 10),
      axis.title = element_text(size = 11)
    )
}

pairs <- list(
  c("Gravimetric.Energy", "Volumetric.Energy"),
  c("Gravimetric.Capacity", "Volumetric.Capacity"),
  c("Stability.Charge", "Stability.Discharge")
)

for (pair in pairs) {
  print(plot_correlation(df, pair[1], pair[2]))
}

Wnioski z analizy

  • Główne jony: Widać wyraźną dominację występowania baterii posiadających Lit (Li) jako główny jon
  • Symetryczność wykresów: Większość wykresów ma charakter prawoskośny, co oznacza, że dane są skupione po lewej stronie z długim ogonem w prawo. Może to wskazywać na obecność outlierów (wartości odstających) w danych, które mają duży wpływ na analizowane zmienne.
  • Skumulowane dane: Wiele atrybutów (np. Steps, Max.Voltage.Step) ma małą zmienność, a dane są skoncentrowane w wąskim zakresie, co może ograniczać ich wartość predykcyjną.
  • Korelacje między atrybutami: Z analizy korelacji wynika, że niektóre atrybuty są ze sobą silnie skorelowane, co sugeruje możliwość ich redukcji lub usunięcia, aby uniknąć problemu multikolinearności w dalszej analizie. Na przykład, atrybuty takie pary jak Gravimetric.Energy i Volumetric.Energy, Gravimetric.Capacity i Volumetric.Capacity, Stability.Charge i Stablility.Discharge wykazują bardzo wysoką dodatnią korelację, co może wpływać na stabilność modeli predykcyjnych.

Regresor

Redukcja korelacji

Aby zredukować korelacje między atrybutami, zastosowano funkcję findCorrelation z pakietu caret, ustawiając próg (cutoff) na 0.8. Funkcja ta identyfikuje atrybuty, które są silnie skorelowane i mogą zostać usunięte z analizy.

attributes_to_remove <- cor_matrix %>% findCorrelation(cutoff = 0.8, names = TRUE)

Atrybuty, które zostały wybrane do usunięcia: Gravimetric.Energy, Gravimetric.Capacity, Stability.Charge.

Trenowanie modelu

Do budowy modelu predykcyjnego usunięto atrybuty Gravimetric.Energy, Gravimetric.Capacity, Stability.Charge oraz Battery.ID. Dane zostały podzielone na zbiór uczący (70%) oraz testowy (30%). Dodatkowo, w celu oceny modelu, zastosowano ocenę krzyżową (cross-validation) z 10-krotnym podziałem zbioru danych na podzbiory.

df$Battery.Formula <- as.numeric(factor(df$Battery.Formula))
df$Working.Ion <- as.numeric(factor(df$Working.Ion))
df$Formula.Charge <- as.numeric(factor(df$Formula.Charge))
df$Formula.Discharge <- as.numeric(factor(df$Formula.Discharge))
in_training_data <- createDataPartition(y = df$Average.Voltage, p = 0.70, list = FALSE)

training_data <- df[in_training_data, ] %>% select(-c(Battery.ID, attributes_to_remove))
testing_data <- df[-in_training_data, ]

ctrl <- trainControl(method = "cv", number = 10)

Poniższy wykres przedstawia podobieństwo rozkładów danych treningowych i testowych.

ggplot() +
  geom_density(aes(x = Average.Voltage, fill = "Treningowy"), data = training_data, alpha = 0.6) +
  geom_density(aes(x = Average.Voltage, fill = "Testowy"), data = testing_data, alpha = 0.6) +
  labs(x = "Average Voltage", y = "Gęstość", fill = "Zbiór danych") +
  theme_light()

model_lm <- train(
  Average.Voltage ~ .,
  data = training_data,
  method = "lm",
  trControl = ctrl
)

Podsumowanie modelu

summary(model_lm)
## 
## Call:
## lm(formula = .outcome ~ ., data = dat)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.3628 -0.6205 -0.0532  0.5495 23.7899 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                3.137e+00  1.156e-01  27.134  < 2e-16 ***
## Battery.Formula           -2.763e-04  5.412e-05  -5.105 3.52e-07 ***
## Working.Ion               -2.464e-02  2.720e-02  -0.906 0.365138    
## Formula.Charge            -1.272e-04  3.465e-05  -3.672 0.000245 ***
## Formula.Discharge          1.570e-04  4.303e-05   3.648 0.000268 ***
## Max.Delta.Volume           2.318e-01  2.532e-02   9.155  < 2e-16 ***
## Volumetric.Capacity       -1.379e-03  6.060e-05 -22.765  < 2e-16 ***
## Volumetric.Energy          9.911e-04  2.085e-05  47.534  < 2e-16 ***
## Atomic.Fraction.Charge     2.533e+00  4.379e-01   5.785 7.97e-09 ***
## Atomic.Fraction.Discharge -1.222e+00  4.222e-01  -2.894 0.003827 ** 
## Stability.Discharge       -4.252e-01  6.202e-02  -6.856 8.56e-12 ***
## Steps                     -2.614e-01  6.466e-02  -4.044 5.40e-05 ***
## Max.Voltage.Step           1.054e-01  5.892e-02   1.789 0.073685 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.174 on 3034 degrees of freedom
## Multiple R-squared:  0.5248, Adjusted R-squared:  0.5229 
## F-statistic: 279.2 on 12 and 3034 DF,  p-value: < 2.2e-16

Predykcje na zbiorze testowym

predictions <- predict(model_lm, newdata = testing_data)
post_resample <- postResample(pred = predictions,
                              obs = testing_data$Average.Voltage)
post_resample
##       RMSE   Rsquared        MAE 
## 3.01947804 0.07085073 0.92448763

Ocena modelu

rmse <- sqrt(mean((testing_data$Average.Voltage - predictions)^2))
cat("RMSE na zbiorze testowym:", rmse)
## RMSE na zbiorze testowym: 3.019478

Poniższy wykres przedstawia wartości zbioru testowego oraz wartości przewidziane przez regresor.

prediction_comparison_df <- tibble(X = testing_data$Battery.ID,
                                   actual = testing_data$Average.Voltage,
                                   predicted = predictions)
prediction_comparison_df$Observation <- seq_along(prediction_comparison_df$X)

p <- ggplot(prediction_comparison_df, aes(x = Observation)) +
  geom_smooth(aes(y = actual, color = "Wartość rzeczywista"), method = "lm", se = FALSE, linetype = "solid") +
  geom_smooth(aes(y = predicted, color = "Wartość przewidziana"), method = "lm", se = FALSE, linetype = "dashed") +
  geom_line(aes(y = actual, color = "Wartość rzeczywista"), linetype = "solid", alpha = 0.2) +
  geom_line(aes(y = predicted, color = "Wartość przewidziana"), linetype = "dashed", alpha = 0.2) +
  labs(color = "Wartości", x = "Nr obserwacji", y = "Average Voltage [V]") +
  theme_light() +
  scale_x_continuous(
    breaks = seq(1, nrow(prediction_comparison_df), by = 1000),
    labels = scales::comma_format()
  ) +  scale_y_continuous(
    limits = c(min(prediction_comparison_df$actual, prediction_comparison_df$predicted),
               max(prediction_comparison_df$actual, prediction_comparison_df$predicted))
  ) +  theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(p)

Ważność atrybutów

importance <- varImp(model_lm, scale = FALSE)
importance_df <- importance$importance %>%
  rownames_to_column(var = "attribute") %>%
  arrange(desc(Overall))

p <- ggplot(importance_df, aes(x = reorder(attribute, Overall), y = Overall, fill = Overall)) +
  geom_bar(stat = "identity") +
  labs(x = "Atrybut", y = "Ważność") +
  scale_fill_gradient() +
  theme_light() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

ggplotly(p)